home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue37 / Alfresco / TestSort.dpr < prev    next >
Encoding:
Text File  |  1998-07-27  |  3.8 KB  |  146 lines
  1. program TestSort;
  2.  
  3. {$IFDEF Windows}
  4. !! Error - 32-bit only
  5. {$ENDIF}
  6.  
  7. {$APPTYPE CONSOLE}
  8.  
  9. uses
  10.   Windows,
  11.   SysUtils,
  12.   SortFns;
  13.  
  14. const
  15.   MaxEIndex = 9999;
  16.  
  17. type
  18.   PSortArray = ^TSortArray;
  19.   TSortArray = array [0..MaxEIndex] of TSortElement;
  20.  
  21. procedure RandomizeSA(var SA : PSortArray);
  22. var
  23.   i : integer;
  24. begin
  25.   for i := 0 to MaxEIndex do
  26.     SA^[i] := Trunc(Random * 1.0e6);
  27. end;
  28.  
  29. function CheckOrder(var SA : PSortArray) : boolean;
  30. var
  31.   i : integer;
  32. begin
  33.   Result := false;
  34.   for i := 1 to MaxEIndex do
  35.     if SA^[i] < SA^[i-1] then
  36.       Exit;
  37.   Result := true;
  38. end;
  39.  
  40. function LessThan(const X, Y : TSortElement) : boolean;
  41. begin
  42.   Result := X < Y;
  43. end;
  44.  
  45. const
  46.   SortName : array [0..7] of string[21] =
  47.              ('Bubble sort          ',
  48.               'Shaker sort          ',
  49.               'Selection sort       ',
  50.               'Usual insertion sort ',
  51.               'Insertion sort       ',
  52.               'Shellsort            ',
  53.               'Usual quicksort      ',
  54.               'quicksort            ');
  55.  
  56. var
  57.   SA : PSortArray;
  58.   StartTime   : integer;
  59.   i           : integer;
  60.   ElapsedTime : array [0..7] of integer;
  61.  
  62. begin
  63.   FillChar(ElapsedTime, sizeof(ElapsedTime), 0);
  64.   try
  65.     New(SA);
  66.     try
  67.       {bubble}
  68.       if (MaxEIndex < 10000) then begin
  69.         RandomizeSA(SA);
  70.         StartTime := GetTickCount;
  71.         BubbleSort(SA^, 0, MaxEIndex, LessThan);
  72.         ElapsedTime[0] := GetTickCount - StartTime;
  73.         if not CheckOrder(SA) then
  74.           writeln('*** Bubble sort failed');
  75.       end;
  76.       {shaker}
  77.       if (MaxEIndex < 10000) then begin
  78.         RandomizeSA(SA);
  79.         StartTime := GetTickCount;
  80.         ShakerSort(SA^, 0, MaxEIndex, LessThan);
  81.         ElapsedTime[1] := GetTickCount - StartTime;
  82.         if not CheckOrder(SA) then
  83.           writeln('*** Shaker sort failed');
  84.       end;
  85.       {selection}
  86.       if (MaxEIndex < 10000) then begin
  87.         RandomizeSA(SA);
  88.         StartTime := GetTickCount;
  89.         SelectionSort(SA^, 0, MaxEIndex, LessThan);
  90.         ElapsedTime[2] := GetTickCount - StartTime;
  91.         if not CheckOrder(SA) then
  92.           writeln('*** Selection sort failed');
  93.       end;
  94.       {usual insertion}
  95.       if (MaxEIndex < 10000) then begin
  96.         RandomizeSA(SA);
  97.         StartTime := GetTickCount;
  98.         UsualInsertionSort(SA^, 0, MaxEIndex, LessThan);
  99.         ElapsedTime[3] := GetTickCount - StartTime;
  100.         if not CheckOrder(SA) then
  101.           writeln('*** Usual insertion sort failed');
  102.       end;
  103.       {insertion}
  104.       if (MaxEIndex < 10000) then begin
  105.         RandomizeSA(SA);
  106.         StartTime := GetTickCount;
  107.         InsertionSort(SA^, 0, MaxEIndex, LessThan);
  108.         ElapsedTime[4] := GetTickCount - StartTime;
  109.         if not CheckOrder(SA) then
  110.           writeln('*** Insertion sort failed');
  111.       end;
  112.       {shellsort}
  113.       RandomizeSA(SA);
  114.       StartTime := GetTickCount;
  115.       Shellsort(SA^, 0, MaxEIndex, LessThan);
  116.       ElapsedTime[5] := GetTickCount - StartTime;
  117.       if not CheckOrder(SA) then
  118.         writeln('*** Shellsort failed');
  119.       {usual quicksort}
  120.       RandomizeSA(SA);
  121.       StartTime := GetTickCount;
  122.       UsualQuickSort(SA^, 0, MaxEIndex, LessThan);
  123.       ElapsedTime[6] := GetTickCount - StartTime;
  124.       if not CheckOrder(SA) then
  125.         writeln('*** Usual quicksort failed');
  126.       {quicksort}
  127.       RandomizeSA(SA);
  128.       StartTime := GetTickCount;
  129.       QuickSort(SA^, 0, MaxEIndex, LessThan);
  130.       ElapsedTime[7] := GetTickCount - StartTime;
  131.       if not CheckOrder(SA) then
  132.         writeln('*** quicksort failed');
  133.  
  134.       for i := 0 to 7 do begin
  135.         writeln(SortName[i], ElapsedTime[i]:10);
  136.       end;
  137.     finally
  138.       Dispose(SA);
  139.     end;
  140.   except
  141.     on E: Exception do
  142.       writeln(E.Message);
  143.   end;
  144.   readln;
  145. end.
  146.